--{-# OPTIONS_GHC -Wall -Werror #-}
{-# LANGUAGE FlexibleContexts, TypeFamilies,
  FlexibleInstances, MultiParamTypeClasses, 
  FunctionalDependencies, TypeSynonymInstances #-}

module Color where

import Math
import Vector4D
import Projectable
import Data.VectorSpace hiding (Scalar)
import Data.AffineSpace
import qualified Data.VectorSpace as VS
import Control.Parallel.Strategies

-- TODO: Add other color types, such as YUVA, HSVA, etc...
newtype Color = RGBA { unRGBA :: Vector4 } deriving (Show,Eq,Read)

instance Project4 Color where
  project4 = project4 . unRGBA
  compose4 = RGBA . compose4

inRGBA :: (Vector4->Vector4) -> Color -> Color
inRGBA f = RGBA . f . unRGBA

rgba :: Scalar -> Scalar -> Scalar -> Scalar -> Color
rgba r g b a = RGBA (V4 r g b a)

rgb :: Scalar -> Scalar -> Scalar -> Color
rgb r g b = rgba r g b 1

rgb8 :: Scalar -> Scalar -> Scalar -> Color
rgb8  r g b   = rgba (r*s) (g*s) (b*s) 1 where s = 1/255

rgba8 :: Scalar -> Scalar -> Scalar -> Scalar -> Color
rgba8 r g b a = rgba (r*s) (g*s) (b*s) (a*s) where s = 1/255

getR :: Color -> Scalar
getR = getX . unRGBA

getG :: Color -> Scalar
getG = getY . unRGBA

getB :: Color -> Scalar
getB = getZ  . unRGBA

getA :: Color -> Scalar
getA = getW  . unRGBA

mapR :: (Scalar->Scalar) -> Color -> Color
mapR = inRGBA . mapX

mapG :: (Scalar->Scalar) -> Color -> Color
mapG = inRGBA . mapY

mapB :: (Scalar->Scalar) -> Color -> Color
mapB = inRGBA . mapZ

mapA :: (Scalar->Scalar) -> Color -> Color
mapA = inRGBA . mapW

withR :: Scalar -> Color -> Color
withR = inRGBA . withX

withG :: Scalar -> Color -> Color
withG = inRGBA . withY

withB :: Scalar -> Color -> Color
withB = inRGBA . withZ

withA :: Scalar -> Color -> Color
withA = inRGBA . withW

instance AffineSpace Color where
  type Diff Color = Vector4
  RGBA v1 .-. RGBA v2 = v2 ^-^ v1
  RGBA v1 .+^ v2 = RGBA (v1 ^+^ v2)

instance NFData Color

